home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Utilities / About… 2.1 ƒ / About… 2.1 Demo Utils.p < prev    next >
Encoding:
Text File  |  1993-07-17  |  13.4 KB  |  447 lines  |  [TEXT/ttxt]
  1. unit DemoUtils;
  2.  
  3.  
  4. interface
  5.  
  6.  
  7.     uses
  8.         About,                        { …my unit! }
  9.         Globals;                    { program globals }
  10.  
  11.  
  12.  
  13.     function aNum2Str (aNum: LongInt): Str255;
  14. { NumToString procedure available as a function }
  15.  
  16.     function aStr2Num (NumStr: Str255): Integer;
  17. { StringToNum procedure available as a function }
  18. { Note: won't accurately return numbers if > 32767 or if letters are in NumStr }
  19.  
  20.     function CtrlEnabled (theDialog: DialogPtr;
  21.                                     whichItem: Integer): Boolean;
  22.  
  23.     procedure DrawDefaultBtn (theDialog: DialogPtr;
  24.                                     Item: Integer);
  25. {  outline default button in any dialog window }
  26.  
  27.     procedure FixWindowColor (theWindow: DialogPtr);
  28. { set window background color to match custom colored window content fill }
  29.  
  30.     procedure CenterWindow (theDialog: DialogPtr);
  31. {  Center window - center higher for large screens - show, set port }
  32.  
  33.     procedure FakeClick (theDialog: DialogPtr;
  34.                                     theButton: Integer);
  35. {   select/deselect a button in a dialog }
  36.  
  37.     procedure SetBtnTitle (theDialog: DialogPtr;
  38.                                     Btn: Integer;
  39.                                     Title: Str255);
  40. { update button title for dialog }
  41.  
  42.     procedure SetCheckOrRadioBtn (theDialog: DialogPtr;
  43.                                     Btn, BtnState: Integer);
  44.   { update radio or check button status for dialog }
  45.  
  46.     function GetEdText (theDialog: DialogPtr;
  47.                                     Which: Integer): Str255;
  48. { return edit text contents }
  49.  
  50.     procedure ChangeChoiceText (theDialog: DialogPtr;
  51.                                     Which: Integer;
  52.                                     Msg: Str255);
  53. { change edit text contents }
  54.  
  55.     function TabSelectText (theDialog: DialogPtr;
  56.                                     direction: Integer): Boolean;
  57.   { select the next, previous, or only edit text field }
  58.   { returns true if a field was found and selected }
  59.  
  60.     function ShiftDown: Boolean;
  61.  
  62.     procedure myDrawSICN (theID, resOffset: Integer;
  63.                                     theRect: Rect);
  64. { draw SICN, placing topleft of SICN in topleft of theRect }
  65.  
  66.     procedure VertCenterRect (var theRect: Rect;
  67.                                     mainRect: Rect);
  68.  
  69.     procedure UpdatePopUp (theDialog: DialogPtr;
  70.                                     var aPopRec: PopUpMenu);
  71.   {  select/deselect a btn in a dialog }
  72.  
  73.     function HandlePopUpSelect (theDialog: DialogPtr;
  74.                                     var aPopRec: PopUpMenu): Boolean;
  75.   { deal with popup menu selection }
  76.  
  77.  
  78.  
  79. implementation
  80.  
  81.  
  82.  
  83.     function aNum2Str (aNum: LongInt): Str255;
  84. { NumToString procedure available as a function }
  85.         var
  86.             NumStr: Str255;
  87.     begin
  88.         NumToString(aNum, NumStr);
  89.         aNum2Str := NumStr;
  90.     end; { of func aNum2Str }
  91.  
  92.  
  93.     function aStr2Num (NumStr: Str255): Integer;
  94. { StringToNum procedure available as a function }
  95. { Note: won't accurately return numbers if > 32767 or if letters are in NumStr }
  96.         var
  97.             aNum: LongInt;
  98.     begin
  99.         StringToNum(Copy(NumStr, 1, 5), aNum);
  100.         if aNum < maxInt then
  101.             aStr2Num := aNum
  102.         else
  103.             aStr2Num := maxInt;
  104.     end; { of func aStr2Num }
  105.  
  106.  
  107.     function CtrlEnabled (theDialog: DialogPtr;
  108.                                     whichItem: Integer): Boolean;
  109.         var
  110.             thetype: Integer;
  111.             itmHdl: Handle;
  112.             itmrect: Rect;
  113.     begin
  114.         GetDItem(theDialog, whichItem, theType, itmHdl, itmrect);{ get button junk }
  115.         CtrlEnabled := (itmHdl <> nil) & (ControlHandle(itmHdl)^^.contrlHilite <> Disable);
  116.     end; { of proc CtrlEnabled }
  117.  
  118.  
  119.     procedure DrawDefaultBtn (theDialog: DialogPtr;
  120.                                     Item: Integer);
  121. {  outline default button in any dialog window }
  122.         var
  123.             theInt: Integer;
  124.             btnHdl: Handle;
  125.             thePen: PenState;
  126.             btnrect: Rect;
  127.     begin
  128.         SetPort(theDialog);                 { set window to current graf port }
  129.         GetPenState(thePen);                               { save current pen }
  130.         if (theDialog <> FrontWindow) | (not CtrlEnabled(theDialog, DialogPeek(theDialog)^.aDefItem)) then
  131.             PenPat(gray);
  132.         GetDItem(theDialog, DialogPeek(theDialog)^.aDefItem, theInt, btnHdl, btnrect);    { get item location }
  133.         Pensize(3, 3);                         { no wimpy button outlines here }
  134.         InsetRect(btnrect, -4, -4);               { set rectangle around button }
  135.         FrameRoundRect(btnrect, 16, 16);                     { draw the sucker! }
  136.         SetPenState(thePen);                                { restore old pen }
  137.     end; { of proc DrawDefaultBtn }
  138.  
  139.  
  140.     function GetAuxWin (theWindow: WindowPtr;
  141.                                     var awHndl: AuxWinHandle): Boolean;
  142.     inline
  143.         $AA42;
  144.  
  145.  
  146.     procedure FixWindowColor (theWindow: DialogPtr);
  147. { set window background color to match custom colored window content fill }
  148.         var
  149.             usedDefaultColors: Boolean;
  150.             theWorld: SysEnvRec;
  151.             RGBbackground: RGBColor;
  152.             awHndl: AuxWinHandle;
  153.             savePort: GrafPtr;
  154.     begin
  155.         if (SysEnvirons(1, theWorld) <> envNotPresent) then    { SysEnvirons call is available }
  156.             if theWorld.hasColorQD then        { has Color QuickDraw - OK to look for window color record… }
  157.                 begin
  158.                     GetPort(savePort);
  159.                     usedDefaultColors := GetAuxWin(theWindow, awHndl);
  160.                     RGBbackground := awHndl^^.awCTable^^.ctTable[cFrameColor].rgb;
  161.                     RGBBackColor(RGBbackground);        { set background to match wContentColor when drawing }
  162.                     SetPort(theWindow);
  163.                     EraseRect(theWindow^.portRect);
  164.                     SetPort(savePort);
  165.                 end;
  166.     end;  { of proc FixWindowColor }
  167.  
  168.  
  169.     procedure CenterWindow (theDialog: DialogPtr);
  170. {  Center window - center higher for large screens - show, set port }
  171.         var
  172.             usedDefaultColors: Boolean;
  173.             theWorld: SysEnvRec;
  174.             RGBbackground: RGBColor;
  175.             awHndl: AuxWinHandle;
  176.     begin
  177.         SetPort(theDialog);                 { set window to current graf port }
  178.         with screenBits, theDialog^ do
  179.             MoveWindow(theDialog, ((bounds.right - bounds.left - portrect.right + portrect.left) div 2), ((bounds.bottom - bounds.top - portrect.bottom + portrect.top + 20) div 3), True);
  180.  
  181.         ShowWindow(theDialog);
  182.         FixWindowColor(theDialog);
  183.     end; { of proc CenterWindow }
  184.  
  185.  
  186.     procedure FakeClick (theDialog: DialogPtr;
  187.                                     theButton: Integer);
  188. {   select/deselect a button in a dialog }
  189.         var
  190.             theInt: Integer;
  191.             LInt: LongInt;
  192.             btnHdl: Handle;
  193.             btnrect: Rect;
  194.     begin
  195.         GetDItem(theDialog, theButton, theInt, btnHdl, btnrect);
  196.         HiliteControl(ControlHandle(btnHdl), 1);
  197.         Delay(8, LInt);
  198.         HiliteControl(ControlHandle(btnHdl), 0);
  199.     end; { of proc FakeClick }
  200.  
  201.  
  202.     procedure SetBtnTitle (theDialog: DialogPtr;
  203.                                     Btn: Integer;
  204.                                     Title: Str255);
  205. { update button title for dialog }
  206.         var
  207.             itmNum: Integer;
  208.             itmRect: Rect;
  209.             CurTitle: Str255;
  210.             itmHdl: Handle;
  211.     begin
  212.         GetDItem(theDialog, Btn, itmNum, itmHdl, itmRect);    { get button junk }
  213.         GetCTitle(ControlHandle(itmHdl), CurTitle);            { get current title }
  214.         if Title <> CurTitle then
  215.             SetCTitle(ControlHandle(itmHdl), Title);            { set title }
  216.     end; { of proc SetBtnTitle }
  217.  
  218.  
  219.     procedure SetCheckOrRadioBtn (theDialog: DialogPtr;
  220.                                     Btn, BtnState: Integer);
  221.   { update radio or check button status for dialog }
  222.         var
  223.             thetype: Integer;
  224.             itmrect: Rect;
  225.             itmHdl: Handle;
  226.     begin
  227.         GetDItem(theDialog, Btn, theType, itmHdl, itmrect);    { get button junk }
  228.         if itmHdl = nil then
  229.             Exit(SetCheckOrRadioBtn);
  230.         if BtnState <> Disable then
  231.             begin
  232.                 HiliteControl(ControlHandle(itmHdl), Off);            { enable control }
  233.                 SetCtlValue(ControlHandle(itmHdl), BtnState)        { set button state }
  234.             end
  235.         else
  236.             HiliteControl(ControlHandle(itmHdl), BtnState);        { disable control }
  237.     end; { of proc SetCheckOrRadioBtn }
  238.  
  239.  
  240.     function GetEdText (theDialog: DialogPtr;
  241.                                     Which: Integer): Str255;
  242. { return edit text contents }
  243.         var
  244.             itmNum: Integer;
  245.             itmrect: Rect;
  246.             itmHdl: Handle;
  247.             Msg: Str255;
  248.     begin
  249.         GetDItem(theDialog, Which, itmNum, itmHdl, itmrect);
  250.         GetIText(itmHdl, Msg);
  251.         GetEdText := Msg;
  252.     end; { of func GetEdText }
  253.  
  254.  
  255.     procedure ChangeChoiceText (theDialog: DialogPtr;
  256.                                     Which: Integer;
  257.                                     Msg: Str255);
  258. { change edit text contents }
  259.         var
  260.             itmNum: Integer;
  261.             itmrect: Rect;
  262.             itmHdl: Handle;
  263.     begin
  264.         if GetEdText(theDialog, Which) <> Msg then        { check current text before updating... }
  265.             begin
  266.                 GetDItem(theDialog, Which, itmNum, itmHdl, itmrect);
  267.                 SetIText(itmHdl, Msg);           { ...to avoid flicker }
  268.             end;
  269.     end; { of proc ChangeChoiceText }
  270.  
  271.  
  272.     function TabSelectText (theDialog: DialogPtr;
  273.                                     direction: Integer): Boolean;
  274.   { select the next, previous, or only edit text field }
  275.   { returns true if a field was found and selected }
  276.         var
  277.             thePtr: ^Integer;
  278.             x, theItem, totItems, itmtype: Integer;
  279.             itmHdl: Handle;
  280.             itmrect: Rect;
  281.     begin
  282.         TabSelectText := False;
  283.         theItem := 0;
  284.         x := Succ(DialogPeek(theDialog)^.editField);   { current edit text item }
  285.         if x = 0 then
  286.             Exit(TabSelectText);             { no edit text fields in dialog! }
  287.         thePtr := Pointer(DialogPeek(theDialog)^.Items^);
  288.         totItems := 1 + thePtr^;    { total # of items in dialog }
  289.         while theItem = 0 do
  290.             begin
  291.                 x := x + direction;
  292.                 if x > totItems then
  293.                     x := 1;   { reset index to first item }
  294.                 if x < 1 then
  295.                     x := totItems;   { reset index to last item }
  296.                 GetDItem(theDialog, x, itmtype, itmHdl, itmrect);  { get item's rect }
  297.                 if (itmtype = editText) or (itmtype = editText + itemDisable) then
  298.                     theItem := x; { found an edit text item }
  299.             end;
  300.         SelIText(theDialog, theItem, 0, maxint); { select ALL edit text }
  301.         TabSelectText := True;
  302.     end;  { of func TabSelectText }
  303.  
  304.  
  305.     function ShiftDown: Boolean;
  306.         var
  307.             keys: keymap;
  308.     begin
  309.         GetKeys(keys);
  310.         shiftdown := bittst(@keys, 63);
  311.     end;
  312.  
  313.  
  314.     procedure myDrawSICN (theID, resOffset: Integer;
  315.                                     theRect: Rect);
  316. { draw SICN, placing topleft of SICN in topleft of theRect }
  317.         var
  318.             theResource: Handle;
  319.             theBits: BitMap;
  320.             byteCount: integer;
  321.             tempPort: GrafPtr;
  322.     begin
  323.         theResource := GetResource('SICN', theID);
  324.         if (theResource <> nil) then
  325.             begin
  326.                 SetRect(theBits.bounds, theRect.left, theRect.top, theRect.left + 16, theRect.top + 16);
  327.                 theBits.rowBytes := (((theBits.bounds.right - theBits.bounds.left) + 15) div 16) * 2;
  328.                 byteCount := Longint(theBits.bounds.bottom - theBits.bounds.top) * longint(theBits.rowBytes);{ Be sure it's a longint }
  329.                 theBits.baseAddr := Ptr(NewPtr(byteCount));
  330.                 if MemError = noErr then
  331.                     begin
  332.                         HLock(theResource);
  333.                         BlockMove(Ptr(Ord(theResource^) + (resOffset * 32)), theBits.baseAddr, 32); { move in 32 bits! }
  334.                         HUnlock(theResource);
  335.                         GetPort(tempPort);
  336.                         CopyBits(theBits, tempPort^.portBits, theBits.bounds, theBits.bounds, srcCopy, nil);{srcCopy    srcOr}
  337.                         DisposPtr(theBits.baseAddr);
  338.                     end;
  339.                 ReleaseResource(theResource);
  340.             end; {maybe we should do something on an error??}
  341.     end;{ of proc myDrawSICN }
  342.  
  343.  
  344.     procedure VertCenterRect (var theRect: Rect;
  345.                                     mainRect: Rect);
  346.         var
  347.             offsetAmt: Integer;
  348.     begin
  349.         offsetAmt := ((mainRect.bottom - mainRect.top) - (theRect.bottom - theRect.top)) div 2;
  350.         OffsetRect(theRect, 0, offsetAmt);
  351.     end;  { of proc VertCenterRect }
  352.  
  353.  
  354.     procedure UpdatePopUp (theDialog: DialogPtr;
  355.                                     var aPopRec: PopUpMenu);
  356.   {  select/deselect a btn in a dialog }
  357.         var
  358.             theIcon: Byte;
  359.             i, Width: Integer;
  360.             SICNrect, popRect: Rect;
  361.             MenuLine: Str255;
  362.             cmdChar: Char;
  363.             fontStuff: FontInfo;
  364.     begin
  365.         SetPort(theDialog);
  366.         GetFontInfo(fontStuff);
  367.         GetItem(aPopRec.MenuHndl, aPopRec.Selected, MenuLine);  { get selection text }
  368.  
  369. { remove trailing spaces - trailing spaces (or option-spaces) are used to pad menu so it will be }
  370. { wide enough to avoid truncating of popup control text in window }
  371. {$push}
  372. {$R-}
  373.         for i := Length(MenuLine) downto 1 do
  374.             if (MenuLine[i] = Chr(32)) | (MenuLine[i] = Chr(202)) then
  375.                 MenuLine[0] := Chr(Pred(Ord(MenuLine[0])))
  376.             else
  377.                 leave;
  378. {$pop}
  379.         popRect := aPopRec.PopUpRect;
  380.  
  381.         EraseRect(popRect);
  382.         FrameRect(popRect);
  383.         MoveTo(popRect.left + 2, popRect.bottom);
  384.         LineTo(popRect.right, popRect.bottom);
  385.         LineTo(popRect.right, popRect.top + 2);
  386.  
  387.         GetItemCmd(aPopRec.MenuHndl, aPopRec.Selected, cmdChar);        { check for SICN in menu }
  388.         if Ord(cmdChar) = 30 then
  389.             begin
  390.                 SetRect(SICNrect, popRect.left + 6, popRect.top, popRect.right, popRect.top + 16);
  391.                 VertCenterRect(SICNrect, popRect);
  392.  
  393.                 GetItemIcon(aPopRec.MenuHndl, aPopRec.Selected, theIcon);
  394.                 myDrawSICN(256 + theIcon, 0, SICNrect);
  395.                 popRect.left := popRect.left + 20;
  396.             end;
  397.  
  398.         Width := popRect.right - popRect.left - 18;
  399.         if StringWidth(MenuLine) > Width then    { simple truncating algorithm }
  400.             begin
  401.                 MenuLine := Concat(MenuLine, '…');
  402.                 while StringWidth(MenuLine) > Width do
  403.                     Delete(MenuLine, Pred(Length(MenuLine)), 1);
  404.             end;
  405.         i := ((popRect.Bottom - popRect.Top) - (fontStuff.ascent + fontStuff.descent)) div 2;
  406.         MoveTo(popRect.Left + 6, popRect.Top + fontStuff.ascent + i);    { move to text position }
  407.         DrawString(MenuLine);
  408.  
  409.         SetRect(SICNrect, popRect.right - 18, popRect.top, popRect.right, popRect.top + 16);
  410.         VertCenterRect(SICNrect, popRect);
  411.         myDrawSICN(popupSICNid, 0, SICNrect);
  412.  
  413.         CheckItem(aPopRec.MenuHndl, aPopRec.Selected, true);
  414.     end; { of proc UpdatePopUp }
  415.  
  416.  
  417.     function HandlePopUpSelect (theDialog: DialogPtr;
  418.                                     var aPopRec: PopUpMenu): Boolean;
  419.   { deal with popup menu selection }
  420.         var
  421.             Result: LongInt;
  422.             MenuStr: Str255;
  423.             theHdl: Handle;
  424.             PopLoc: Rect;
  425.             itemType: Integer;
  426.     begin
  427.         if aPopRec.canInvert then
  428.             InvertRect(aPopRec.promptRect);        { invert popupmenu prompt item }
  429.         PopLoc := aPopRec.PopUpRect;
  430.         LocalToGlobal(PopLoc.TopLeft);
  431.         CalcMenuSize(aPopRec.MenuHndl);        { Work around Menu Mgr bug }
  432.         Result := PopUpMenuSelect(aPopRec.MenuHndl, PopLoc.TopLeft.v, PopLoc.TopLeft.h, aPopRec.Selected);
  433.         if aPopRec.canInvert then
  434.             InvertRect(aPopRec.promptRect);        { invert popupmenu prompt item }
  435.         if (LoWord(Result) > 0) and (LoWord(Result) <> aPopRec.Selected) then
  436.             begin
  437.                 GetItem(aPopRec.MenuHndl, LoWord(Result), MenuStr);  { get selection text }
  438.                 CheckItem(aPopRec.MenuHndl, aPopRec.Selected, False);
  439.                 aPopRec.Selected := LoWord(Result);
  440.                 HandlePopUpSelect := True;
  441.             end
  442.         else
  443.             HandlePopUpSelect := False;
  444.     end;  { of func HandlePopUpSelect }
  445.  
  446.  
  447. end.